library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.3 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(recommenderlab)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
##
## Loading required package: arules
##
## Attaching package: 'arules'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following objects are masked from 'package:base':
##
## abbreviate, write
##
## Loading required package: proxy
##
## Attaching package: 'proxy'
##
## The following object is masked from 'package:Matrix':
##
## as.matrix
##
## The following objects are masked from 'package:stats':
##
## as.dist, dist
##
## The following object is masked from 'package:base':
##
## as.matrix
##
## Registered S3 methods overwritten by 'registry':
## method from
## print.registry_field proxy
## print.registry_entry proxy
data("MovieLense")
UIB <- binarize(MovieLense, minRating = 4)
UIB <- as(UIB, "matrix")
UIB[1:5, 1:5]
## Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995)
## 1 TRUE FALSE TRUE FALSE
## 2 TRUE FALSE FALSE FALSE
## 3 FALSE FALSE FALSE FALSE
## 4 FALSE FALSE FALSE FALSE
## 5 TRUE FALSE FALSE FALSE
## Copycat (1995)
## 1 FALSE
## 2 FALSE
## 3 FALSE
## 4 FALSE
## 5 FALSE
In der UIB (User Item Binär) Matrix sind Ratings kleiner als 4 mit False und sonst als True kodiert.
dim(UIB)
## [1] 943 1664
Die Matrix UIB hat 943 User und 1664 Filme.
movieGenreDf <- MovieLenseMeta %>% select(-c(year, url))
rownames(movieGenreDf) <- movieGenreDf[,1]
movieGenreDf <- movieGenreDf %>% select(-c(title))
MGM <- as.matrix(movieGenreDf)
MGM[1:3, 1:3]
## unknown Action Adventure
## Toy Story (1995) 0 0 0
## GoldenEye (1995) 0 1 1
## Four Rooms (1995) 0 0 0
Wir sehen die ersten drei Zeilen (Filme) und die ersten drei Spalten (Genres) mit Unknown, Action und Adventure. Falls das Genre zustimmt für den Film, steht eine 1 sonst 0.
dim(MGM)
## [1] 1664 19
MGM (Movie Genre Matrix) hat 1664 Zeilen als Filme und 19 Spalten als Genres.
getMovieGenreMatrix <- function(movieLenseMeta) {
movieGenreDf <- movieLenseMeta %>% select(-c(year, url))
rownames(movieGenreDf) <- movieGenreDf[, 1]
movieGenreDf <- movieGenreDf %>% select(-c(title))
MGM <- as.matrix(movieGenreDf)
return(MGM)
}
MGM <- getMovieGenreMatrix(MovieLenseMeta)
genreColNames <- colnames(MGM)
for (colName in genreColNames) {
MGM[, colName] <- ifelse(MGM[, colName] == 1, colName, NA)
}
MGMdf <- as.data.frame(MGM)
# Concatenate row-wise with a separator
MGMdfConcat <- MGMdf %>%
unite("profile", sep = ".", na.rm = TRUE, remove = TRUE)
# Group by profile, count the occurrences and arrange in descending order
genreCounts <- MGMdfConcat %>%
group_by(profile) %>%
summarise(Anzahl = n()) %>%
arrange(desc(Anzahl))
# Select the top 20 profiles by count and arrange them by count
top20Genres <- genreCounts %>%
head(20) %>%
arrange(Anzahl)
# Create a bar plot
ggplot(top20Genres, aes(x = Anzahl, y = profile, fill = "blue")) +
geom_bar(stat = "identity") +
labs(title = "Genre Combinations and Occurencies (MovieProfiles)",
x = "Occurencies",
y = "Genre",
subtitle = "MovieLens Dataset") +
theme(legend.position = "none")
Wir sehen im Plot die Kombination diverser Genres und deren Häufigkeit. Drama taucht am häufigsten auf, gefolgt von Comedy.
MGM <- getMovieGenreMatrix(MovieLenseMeta)
UIB <- as.matrix(UIB)
MGM <- as.matrix(MGM)
# If the matrices contain non-numeric data
UIB <- apply(UIB, 2, as.numeric)
MGM <- apply(MGM, 2, as.numeric)
# matrix multiplication
# UGM = User Genre Matrix
UGM <- UIB %*% MGM
# UGPdf = User Genre Profile Data Frame
UGPdf <- as.data.frame(UGM)
head(UGPdf)
Wir sehen die Nutzerprofile, d.h. zu jeder Nutzerin wie häufig ihr ein Genre gefallen hat, basierend auf ihren Ratings (Binäre User-Liked-Items Matrix).
dim(UGPdf)
## [1] 943 19
943 Nutzerinnen und 19 Genres.
# (a) vollständig
print(paste("Unterschiedliche Nutzerprofile vollständig:", nrow(unique(UGPdf))))
## [1] "Unterschiedliche Nutzerprofile vollständig: 943"
# (b) binär
UPB <- UGPdf > (2 * rowMeans(UGPdf))
print(paste("Unterschiedliche Nutzerprofile Binär:", nrow(unique(UPB))))
## [1] "Unterschiedliche Nutzerprofile Binär: 137"
Eine nicht-binäre User-Profil-Matrix hat nur unterschiedliche Nutzerprofile. Eine binäre User Profile Matrix hat in diesem Fall 137 unterschiedliche Nutzerprofile.
getCosineSim <- function(M, A) {
MA_T <- M %*% t(A)
l2NormM <- sqrt(rowSums(M^2))
l2NormA <- sqrt(rowSums(A^2))
l2Norm <- l2NormM %*% t(l2NormA)
return(MA_T / l2Norm)
}
cosine_UGM_MGM <- getCosineSim(UGM, MGM)
Die folgende Funktion berechnet die Kosinus Ähnlichkeit zwischen zwei Matrizen, in diesem Fall zwischen der User-Genre-Matrix und Movie-Genre-Matrix.
dim(cosine_UGM_MGM)
## [1] 943 1664
Die Ähnlichkeitsmatrix hat 943 Zeilen (Nutzerinnen) und 1664 Spalten (Filme)
v <- as.vector(cosine_UGM_MGM)
summary(v)
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.0000 0.2300 0.4070 0.4098 0.5919 0.9768 1664
Wir können prüfen ob die Ähnlichkeitsmatrix korrekt berechnet wurden, indem das Intervall von Min. und Max. zwischen [0, 1] liegt, was hier der Fall ist.
density <- data.frame(x = as.vector(cosine_UGM_MGM))
ggplot(density, aes(x)) +
geom_density() +
labs(title = "Density Plot of Cosine Similarity between Users and Movies", x = "Cosine Similarity", y = "Density") +
theme_minimal()
## Warning: Removed 1664 rows containing non-finite values (`stat_density()`).
Im Dichteplot sehen wir sehr viele Werte nahe bei Null. Die meisten Werte befinden sich aber im Intervall [0.25, 0.75].
ggplot() +
geom_density(aes(cosine_UGM_MGM[, 241], color = "Genre 1"), fill = "yellow", alpha = 0.05) +
geom_density(aes(cosine_UGM_MGM[, 414], color = "Genre 2"), fill = "green", alpha = 0.05) +
geom_density(aes(cosine_UGM_MGM[, 477], color = "Genre 3"), fill = "blue", alpha = 0.05) +
geom_density(aes(cosine_UGM_MGM[, 526], color = "Genre 4"), fill = "orange", alpha = 0.05) +
#geom_density(aes(cosine_UGM_MGM[, 640], color = "Genre 5"), fill = "black", alpha = 0.05) +
geom_density(aes(cosine_UGM_MGM[, 710], color = "Genre 6"), fill = "purple", alpha = 0.05) +
labs(
title = "Density Plot of Cosine Similarity between Users and Genres",
x = "Cosine Similarity",
y = "Density"
) +
scale_color_manual(
name = "Genres",
values = c("Genre 1" = "yellow", "Genre 2" = "green", "Genre 3" = "blue",
"Genre 4" = "orange", "Genre 6" = "purple")
) +
theme_minimal()
## Warning: Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
ggplot() +
geom_density(aes(cosine_UGM_MGM[, 241], color = "Genre 1"), fill = "yellow", alpha = 0.05) +
geom_density(aes(cosine_UGM_MGM[, 414], color = "Genre 2"), fill = "green", alpha = 0.05) +
geom_density(aes(cosine_UGM_MGM[, 477], color = "Genre 3"), fill = "blue", alpha = 0.05) +
geom_density(aes(cosine_UGM_MGM[, 526], color = "Genre 4"), fill = "orange", alpha = 0.05) +
geom_density(aes(cosine_UGM_MGM[, 640], color = "Genre 5"), fill = "black", alpha = 0.05) +
geom_density(aes(cosine_UGM_MGM[, 710], color = "Genre 6"), fill = "purple", alpha = 0.05) +
labs(
title = "Density Plot of Cosine Similarity between Users and Genres",
x = "Cosine Similarity",
y = "Density"
) +
scale_color_manual(
name = "Genres",
values = c("Genre 1" = "yellow", "Genre 2" = "green", "Genre 3" = "blue",
"Genre 4" = "orange", "Genre 5" = "black", "Genre 6" = "purple")
) +
theme_minimal()
## Warning: Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
Wir sehen für Genre 5 einen starken Anstieg nahe 0, d.h. viele Nutzerinnen haben keine Ähnlichkeit mit diesem Genre. Wir müssen Genre 5 aus der Visualisierung entfernen, weil wir sonst die restliche nicht miteinander vergleichen können. Genre 4 hat weniger Ähnlichkeit mit den Nutzerinnen, und liegt mehr im Bereich von 0.25. Genre 1, 2 und 3 scheinen Ähnlichkeiten mit den Nutzerinnen zu teilen. Genre 6 ist den Nutzerinnen am ähnlichsten.
URM <- as(MovieLense, "matrix")
URMmasked <- is.na(URM)
URMmasked[1:4, 1:4]
## Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995)
## 1 FALSE FALSE FALSE FALSE
## 2 FALSE TRUE TRUE TRUE
## 3 TRUE TRUE TRUE TRUE
## 4 TRUE TRUE TRUE TRUE
Um den Negativabzug der User-Item Matrix zu erzeugen, werden fehlende Werte mit der Funktion is.na() auf True und sonst False gesetzt.
userSums <- rowSums(URMmasked)[c(5, 25, 50, 150)]
relative <- userSums / ncol(URM)
userSums
## 5 25 50 150
## 1489 1586 1641 1633
relative
## 5 25 50 150
## 0.8948317 0.9531250 0.9861779 0.9813702
Alle vier User haben mehr als 1000 Filme bewertet. Damit liegen sie im Bereich von 90% und höher, im Bezug auf fehlende Bewertungen.
summary(rowSums(URMmasked))
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 929 1516 1600 1559 1632 1645
Es gibt eine oder mehrere Nutzerinnen die noch 929 Filme von 1664 nicht bewertet haben. Im Durchschnitt haben die Nutzerinnen 1559 Filme nicht bewertet. 25% von allen Nutzerinnen haben 1516 Filme nicht bewertet und 75% von allen Nutzerinnen haben 1632 Filme nicht bewertet.
URM_CS <- URMmasked * cosine_UGM_MGM
URM_CS[1:3, 1:4]
## Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995)
## 1 0.0000000 0.0000000 0.0000000 0.0000000
## 2 0.0000000 0.3004993 0.1951800 0.7700294
## 3 0.1549193 0.4647580 0.3577709 0.6713171
Die maskierte User Rating Matrix mit der Cosinus Ähnlichkeitsmatrix zwischen User-Genre und Movie-Genre erzeugt eine neue Matrix die 0 aufweist, falls die Filme vom User schon bewertet wurden. Werte ungleich Null sind Ähnlichkeiten zwischen Nutzerinnen und Filmen.
dim(URM_CS)
## [1] 943 1664
Die Dimensionen sind gleichbleibend.
getTopNList <- function(n, R) {
topN <- matrix(0, dim(R), n)
for (userId in rownames(R)) {
topN[as.numeric(userId), ] <- names(sort(R[userId, ], decreasing = TRUE)[1:n])
}
return(topN)
}
top20 <- getTopNList(20, URM_CS)
top20[1:5, 1:5]
## [,1] [,2]
## [1,] "House of Yes, The (1997)" "Best Men (1997)"
## [2,] "Cinema Paradiso (1988)" "Wings of Desire (1987)"
## [3,] "Wild Things (1998)" "Diva (1981)"
## [4,] "From Dusk Till Dawn (1996)" "Diva (1981)"
## [5,] "Army of Darkness (1993)" "Money Talks (1997)"
## [,3] [,4]
## [1,] "Wings of Desire (1987)" "Manhattan (1979)"
## [2,] "Manhattan (1979)" "American President, The (1995)"
## [3,] "Client, The (1994)" "2001: A Space Odyssey (1968)"
## [4,] "Apollo 13 (1995)" "Outbreak (1995)"
## [5,] "I Love Trouble (1994)" "Low Down Dirty Shame, A (1994)"
## [,5]
## [1,] "American President, The (1995)"
## [2,] "Corrina, Corrina (1994)"
## [3,] "Midnight in the Garden of Good and Evil (1997)"
## [4,] "Terminator 2: Judgment Day (1991)"
## [5,] "Cowboy Way, The (1994)"
Die Funktion liefert die Top-N Liste für den jeweiligen User basierend auf der Ähnlichkeits-Matrix aus der vorangegangen Aufgabe.
getTopNListSim <- function(n, R) {
topN <- matrix(0, dim(R), n)
for (userId in rownames(R)) {
topN[as.numeric(userId), ] <- sort(R[userId, ], decreasing = TRUE)[1:n]
}
return(topN)
}
simN10 <- tibble(x = getTopNListSim(10, URM_CS)[, 10])
simN50 <- tibble(x = getTopNListSim(50, URM_CS)[, 50])
simN100 <- tibble(x = getTopNListSim(100, URM_CS)[, 100])
Die Funktion liefert die Top-N Liste als Ähnlichkeitswerte. Wir gehen davon aus, dass je mehr Filme empfohlen werden, desto weniger ähnlich sind sie zu der Nutzerin.
ggplot(simN10, aes(x)) +
geom_histogram(binwidth = 0.005, na.rm = TRUE) +
xlim(0, 1) +
ylim(0, 35) +
labs(title = "Similarity Distribution of Top 10 Recommendations of all Users", x = "Similarity", y = "Occurencies") +
theme_minimal()
Für die top 10 Produkte liegen die meisten Ähnlichkeiten zwischen 0.70 und 0.9.
ggplot(simN50, aes(x)) +
geom_histogram(binwidth = 0.005, na.rm = TRUE) +
xlim(0, 1) +
ylim(0, 35) +
labs(title = "Similarity Distribution of Top 50 Recommendations of all Users", x = "Similarity", y = "Occurencies") +
theme_minimal()
Wir sehen bei 50 schon einen guten Versatz der Verteilung Richtung links (weniger ähnlich).
ggplot(simN100, aes(x)) +
geom_histogram(binwidth = 0.005, na.rm = TRUE) +
xlim(0, 1) +
ylim(0, 35) +
labs(title = "Similarity Distribution of Top 100 Recommendations of all Users", x = "Similarity", y = "Occurencies") +
theme_minimal()
Vergleichen wir die Top 10 und die Top 100, sehen wir den Unterschied ganz klar. Je mehr wir empfehlen, desto kleiner ist der Ähnlichkeitswert zwischen der Nutzerin und dem Film.
# some bug, had to refactor topNList function
getTopNList <- function(N, URM) {
topNList <- list()
nUser <- dim(URM)[1]
nMovies <- dim(URM)[2]
for (user in 1:nUser) {
topNList[[user]] <- sort(URM[user, ], decreasing=TRUE)[1:N]
}
return(topNList)
}
plotCleveland <- function(URM, N, user) {
topNList <- getTopNList(N, URM)
topNUser <- topNList[[user]]
simUser <- as.numeric(topNUser)
movies <- names(topNUser)
topNdf <- data.frame(movies, simUser)
ggplot(topNdf, aes(x = simUser, y = movies)) +
geom_point() +
labs(title = paste("Top", N, "Recommendations for User", user),
x = "Similarity",
y = "Movie",
subtitle = "MovieLense Dataset")
}
for (user in c(5, 25, 50, 150)) {
print(plotCleveland(URM_CS, 20, user))
}
Im Cleveland Plot mit den den Top 20 Film Empfehlungen und den Ähnlichkeiten sehen wir für die User folgendes: User 5: Hat eine ausgeglichene Auswahl bekommen mit hohen Werten zwischen 0.7 und 0.8. User 25: Sieht man schon ein Cluster im Bereich von 0.65, entweder hat dieser nur wenige Filme bewertet oder ähnliche Filme bewertet. User 50: Sieht man klar das dieser nur das vorgeschlagen bekommt, was er schon gesehen/bewertet hat, weil er vielleicht nur wenige Bewertungen gegeben hat. Die diversity in dieser Empfehlung ist schlecht. Content-based Modelle tendieren dazu, nur vorzuschlagen was von der Nutzerin gemocht wurde. User 150: Sieht man ein Cluster im höheren Ende der Ähnlichkeitsskala, mit einer gewissen Varianz, diese Liste scheint eine gute Balance zu finden.
Ns <- c(20,30,40,50)
users <- c(133, 555)
rowSums(URMmasked[users,])
## 133 555
## 1638 1612
for (n in Ns) {
for (user in users) {
print(plotCleveland(URM_CS, n, user))
}
}
Der Content-Based Recommender schlägt für die Nutzerin 133 sehr eintönige Bewertungen vor, dies kann daran liegen das diese wenige oder immer die gleiche Art von Genres bewertet hat. Nutzerin 133 hat auch weniger Bewertungen abgegeben 1664-1638 = 26, im Vergleich zu User 555, 1664 - 1612 = 52. Der Recommender schlägt bei der Nutzerin 555 schon eine grössere Varianz vor. Man sieht auch für grössere N, dass die Werte sich den User Profilen nähern.